beta_changesfandomcom-20200213-history
WordStar:3.30:DOS:MBC-550 OEM/WSCOLOR.BAS
WordStar color install BASIC program. File content 100 REM WordStar 3.30 color install for Sanyo MBC-550/555 9/28/83 110 KEY OFF 120 COLOR 2,0 130 CLS 140 IBIT = 0 150 DEF FNCOL(XC,YC)=YC-9+INT((XC-9)/8)*16 AND 247 :'REV 83.9.26 160 NEWIVON=7 170 NEWIVOFF=7 180 DIM DAT%(100) 190 LOCATE 4,13 200 PRINT "SANYO WordStar 3.30 "; 210 COLOR 0,4 220 PRINT "COLOR"; 230 COLOR 2,0 240 PRINT " Installation program" 250 GOSUB 2440 260 COLOR 7,0 270 LOCATE 17,1 280 PRINT "Name of file containing INSTALLED WordStar WS.COM "; 290 INPUT WSFILENAME$ 300 IF LEN(WSFILENAME$)=0 THEN WSFILENAME$="WS.COM": GOTO 320 310 IF ((INSTR(WSFILENAME$,".COM")=0) AND (INSTR(WSFILENAME$,".com")=0)) THEN WSFILENAME$=WSFILENAME$+".COM" 320 'ON ERROR GOTO 2400 330 OPEN "I",#1,WSFILENAME$ 340 CLOSE #1 350 OPEN "R",#1,WSFILENAME$,1:' S #1 LEN=1 360 FIELD #1, 1 AS CHAR$ 370 GET #1,&H185 380 CIVON=ASC(CHAR$) 390 GET #1,&H18C 400 CIVOFF=ASC(CHAR$) 410 GOSUB 2830 420 ' 430 ' 440 ' Display available color combinations 450 ' 460 ' 470 CLS 480 LOCATE 1,1 490 PRINT " Sanyo WordStar "; 500 COLOR 4,0 510 PRINT "C"; 520 COLOR 2,0 530 PRINT "O"; 540 COLOR 3,0 550 PRINT "L"; 560 COLOR 5,0 570 PRINT "O"; 580 COLOR 6,0 590 PRINT "R"; 600 COLOR 7,0 610 PRINT " INSTALL, Micro";: COLOR 4,0: PRINT "Pro";: COLOR 7,0: PRINT " International Corporation, 1983" 620 PRINT 630 PRINT "Blinking indicates current selection; use arrow keys to locate new selection." 640 LOCATE 5,1 650 PRINT " AVAILABLE FOREGROUND/BACKGROUND COLOR COMBINATIONS" 660 PRINT 670 RESTORE 940 680 COLOR 7,0 690 PRINT " "; 700 FOR I = 0 TO 7 710 READ C$ 720 COLOR 7,I 730 IF I= 7 THEN COLOR 0,7 740 PRINT C$; 750 PRINT " "; 760 NEXT I 770 PRINT 780 RESTORE 940 790 FOR I= 0 TO 7 800 READ C$ 810 COLOR 7,0 820 PRINT 830 COLOR I,7 840 IF I=7 THEN COLOR 7,0 850 PRINT C$; 860 COLOR 7,0 870 PRINT " "; 880 FOR J= 0 TO 7 890 COLOR I,J 900 PRINT " Text "; 910 NEXT J 920 NEXT I 930 COLOR 7,0 940 DATA " None "," Blue "," Green "," Cyan "," Red ","Magenta","Yellow "," White " 950 COLOR 7,0 960 LOCATE 18,65 970 PRINT " OLD" 980 LOCATE 19,66 990 COLOUR=CIVON:GOSUB 2040 1000 COLOR FORE,BACK 1010 PRINT " Menu "; 1020 LOCATE 20,66 1030 COLOUR=CIVOFF: GOSUB 2040 1040 COLOR FORE,BACK 1050 PRINT " Text "; 1060 COLOR 7,0 1070 LOCATE 19,1: PRINT "Key Action"; 1080 LOCATE 20,1: PRINT " C Copy OLD colors to NEW" 1090 LOCATE 21,1: PRINT " M Set MENU colors to current selection" 1100 LOCATE 22,1: PRINT " T Set TEXT colors to current selection" 1110 LOCATE 23,1: PRINT " X EXIT this program" 1120 LOCATE 24,1: PRINT "RETURN Install new colors into ";:COLOR 0,7: PRINT " ";WSFILENAME$;" ";: COLOR 7,0 1130 GOSUB 1890 1140 YC=12: XC=42 1150 LOCATE YC,XC 1160 GOSUB 1530 1170 C$=INKEY$: IF C$="" THEN 1150 1180 'IF LEN(C$)=2 THEN GOTO 1270:'REV 83.9.26 1190 IF C$="M" OR C$="m" THEN GOSUB 1620 1200 IF C$="T" OR C$="t" THEN GOSUB 1660 1210 IF C$="C" OR C$="c" THEN GOSUB 2080 1220 IF C$="X" OR C$="x" THEN GOTO 2120 1230 IF C$=CHR$(13) THEN GOSUB 1700 1240 'GOTO 1170:'REV 83.9.26 1250 'C$=RIGHT$(C$,1):'REV 83.9.26 1260 IF C$="8" OR C$=CHR$(&H1E) OR C$=CHR$(&H5) THEN GOSUB 1340 1270 IF C$="4" OR C$=CHR$(&H1C) OR C$=CHR$(&H13) THEN GOSUB 1310 1280 IF C$="6" OR C$=CHR$(&H1D) OR C$=CHR$(&H4) THEN GOSUB 1400 1290 IF C$="5" OR C$=CHR$(&H1F) OR C$=CHR$(&H18) THEN GOSUB 1370 1300 GOTO 1150 1310 GOSUB 1480: XC=XC-8 1320 GOSUB 1430 1330 RETURN 1340 GOSUB 1480: YC=YC-1 1350 GOSUB 1430 1360 RETURN 1370 GOSUB 1480 : YC=YC+1 1380 GOSUB 1430 1390 RETURN 1400 GOSUB 1480: XC=XC+8 1410 GOSUB 1430 1420 RETURN 1430 IF XC<10 THEN XC=10 1440 IF XC>66 THEN XC=66 1450 IF YC<9 THEN YC=9 1460 IF YC>16 THEN YC=16 1470 RETURN 1480 LOCATE YC,XC 1490 BC=(XC-9)/8 AND 7:'REV 83.9.26 1500 FC=(YC-9) AND 7:'REV 83.9.26 1510 COLOR FC,BC: PRINT " Text "; 1520 RETURN 1530 BC=(XC-9)/8 AND 7:'REV 83.9.26 1540 FC=(YC-9) AND 7:'REV 83.9.26 1550 COLOR FC,BC:'REV 83.9.26:COLOR FC+16,BC 1560 IF XC=8*YC-62 THEN GOTO 1590 1570 LOCATE YC,XC: PRINT "**Text**"; 1580 RETURN 1590 COLOR 23 AND 7,0 :LOCATE YC,XC: PRINT "** **";:'REV 83.9.26 1600 RETURN 1610 STOP 1620 GOSUB 2300 1630 NEWIVON= FNCOL(XC,YC) 1640 GOSUB 1890 1650 RETURN 1660 GOSUB 2300 1670 NEWIVOFF=FNCOL(XC,YC) 1680 GOSUB 1890 1690 RETURN 1700 COLOR 7,0 1710 LOCATE 25,1: PRINT "Are you pleased with the NEW colors (Y/N) "; 1720 COLOR 20 AND 7,7: PRINT "?"; : COLOR 7,0:'REV 83.9.26 1730 Y$=INKEY$ 1740 IF Y$="" THEN 1730 1750 LOCATE 25,1: PRINT " "; 1760 IF Y$="Y" OR Y$="y" THEN 1780 1770 RETURN 1780 LSET CHAR$=CHR$(NEWIVON) 1790 PUT #1,&H185 1800 LSET CHAR$=CHR$(NEWIVOFF) 1810 PUT #1,&H18C 1820 COLOR 0,7 1830 LOCATE 25,1 1840 PRINT " ";WSFILENAME$;" ";: COLOR 7,0: PRINT " patching completed."; 1850 FOR I=1 TO 1500:NEXT 1860 LOCATE 25,1: PRINT " "; 1870 GOSUB 2120 1880 RETURN 1890 COLOR 7,0 1900 LOCATE 18,52 1910 PRINT "NEW"; 1920 COLOUR=NEWIVON 1930 GOSUB 2040 1940 COLOR FORE,BACK 1950 LOCATE 19,50 1960 PRINT " Menu "; 1970 COLOUR=NEWIVOFF 1980 GOSUB 2040 1990 COLOR FORE,BACK 2000 LOCATE 20,50 2010 PRINT " Text "; 2020 COLOR FC,BC 2030 RETURN 2040 FORE=(7 AND COLOUR) 2050 BACK=(112 AND COLOUR)/16 AND 7:'REV 83.9.26 2060 'IF (COLOUR AND 8) THEN FORE=FORE+8:'REV 83.9.26 2070 RETURN 2080 NEWIVON=CIVON 2090 NEWIVOFF=CIVOFF 2100 GOSUB 1890 2110 RETURN 2120 CLOSE #1 2130 COLOR 7,0:LOCATE 25,1: PRINT "Do you want to EXIT the program (Y/N) "; 2140 COLOR 20 AND 7,7: PRINT "?"; : COLOR 7,0:'REV 83.9.26 2150 Y$=INKEY$ 2160 IF Y$="" THEN 2150 2170 IF Y$="Y" OR Y$="y" THEN 2290 2180 LOCATE 25,1: PRINT " "; 2190 OPEN "I",#1,WSFILENAME$:' FOR INPUT AS #1 2200 CLOSE #1 2210 OPEN "R",#1,WSFILENAME$,1:' AS #1 LEN=1 2220 FIELD #1, 1 AS CHAR$ 2230 GET #1,&H185 2240 CIVON=ASC(CHAR$) 2250 GET #1,&H18C 2260 CIVOFF=ASC(CHAR$) 2270 GOSUB 1480 2280 GOTO 950 2290 CLOSE:SYSTEM 2300 COLOR 7,0 2310 LOCATE 25,1 2320 'PRINT "Do you want the characters HIGH-LIGHTED (Y/N) ";: COLOR 20 AND 7,7:PRINT "? ";:'REV 83.9.26 2330 'I$=INKEY$ 2340 'IF I$="" THEN 2340 2350 'IBIT = 0 2360 'IF I$="Y" OR I$="y" THEN IBIT=8 2370 'COLOR 7,0: LOCATE 25,1: PRINT " "; 2380 RETURN 2390 PRINT " The file ";WSFILENAME$;" cannot be found. Try again." 2400 FOR I=1 TO 500 2410 A$ = "This is a delay loop" 2420 NEXT I 2430 CLS:RESUME 270 2440 COLOR 7,0 2450 LOCATE 6,1: PRINT "This program will allow you to change the colors used in Wordstar 3.30" 2460 PRINT "on the SANYO MBC-550/555 (with a color monitor) any time you wish" 2470 PRINT "to do so. Be sure to run WINSTALL first." 2480 PRINT " " 2490 PRINT "Once you have run this program, your copy of WS.COM may not function" 2500 PRINT "properly with your monochrome monitor. Be sure make backup copy of your" 2510 PRINT "original first." 2520 PRINT 2530 PRINT "Do you want to continue with this program (Y/N) "; 2540 COLOR 4,7: PRINT "?"; :COLOR 7,0 2550 Y$ = INKEY$ 2560 IF Y$="" THEN 2550 2570 IF Y$="N" OR Y$="n" THEN 2590 2580 GOTO 2600 2590 SYSTEM 2600 CLS 2610 PRINT "WSCOLOR will enhance your enjoyment of WordStar without affecting its" 2620 PRINT "performance in any way. It is provided by MicroPro solely as a free" 2630 PRINT "addition to WordStar. The program is written in Advanced Basic and is" 2640 PRINT "supplied with source code." 2650 PRINT:PRINT 2660 PRINT "Once you have given WSCOLOR the name of your WordStar COM file, you may" 2670 PRINT "select the colors you desire from the displayed palette by moving the" 2680 PRINT "cursor and choosing the desired action. When you have finished and" 2690 PRINT "exited normally from WSCOLOR, subsequent use of WordStar will display" 2700 PRINT "those colors. If you don't like the effect, run WSCOLOR again." 2710 PRINT: PRINT 2720 PRINT "Do you still wish to continue (Y/N) ";:COLOR 4,7: PRINT "?"; 2730 COLOR 7,0 2740 Y$=INKEY$ 2750 IF Y$="" THEN 2740 2760 IF Y$="N" OR Y$="n" THEN GOTO 2780 2770 RETURN 2780 SYSTEM 2790 DATA &HB8,&H03,&H00,&HCD,&H10,&HC3 2800 DATA &HB8,&H02,&H00,&HCD,&H10,&HC3 2830 RESTORE 2790 2840 FOR I = 1 TO 12 2850 READ DAT%(I) 2860 NEXT I 2870 NPATCHES=I 2880 FADDRESS=&H24F 2890 FOR I = 1 TO NPATCHES 2900 FADDRESS=FADDRESS+1 2910 LSET CHAR$=CHR$(DAT%(I)) 2920 PUT #1,FADDRESS 2930 NEXT I 2940 FADDRESS=&H1A5 2950 LSET CHAR$=CHR$(&HE9) 2960 PUT #1,FADDRESS 2970 FADDRESS=FADDRESS+1 2980 LSET CHAR$=CHR$(&HA8) 2990 PUT #1,FADDRESS 3000 FADDRESS=FADDRESS+1 3010 LSET CHAR$=CHR$(&H0) 3020 PUT #1,FADDRESS 3030 FADDRESS=FADDRESS+1 3040 LSET CHAR$=CHR$(&HE9) 3050 PUT #1,FADDRESS 3060 FADDRESS=FADDRESS+1 3070 LSET CHAR$=CHR$(&HAB) 3080 PUT #1,FADDRESS 3090 FADDRESS=FADDRESS+1 3100 LSET CHAR$=CHR$(&H0) 3110 PUT #1,FADDRESS 3120 RETURN 3130 C$=INKEY$:IF C$="" THEN 3130 3140 PRINT LEN(C$) 3150 PRINT HEX$(ASC(C$)) 3160 GOTO 3130 � Program in Action NOTE: I can't get it fully working, after entering color selection screen, the program hangs up, and it is impossible to continue.